home *** CD-ROM | disk | FTP | other *** search
/ Just Call Me Internet / Just Call Me Internet.iso / prog / atari / m2 / cat3src / magic / i / mtalerts.i < prev    next >
Encoding:
Modula Implementation  |  1997-10-26  |  22.0 KB  |  571 lines
  1. (*----------------------------------------------------------------------*
  2.  *                                                                      *
  3.  *  MAGICTOOLS   Modula's  All purpose  GEM  Interface  Cadre  Toolbox  *
  4.  *               ÿ         ÿ            ÿ    ÿ          ÿ               *
  5.  *----------------------------------------------------------------------*
  6.  * Version 3.30  02.02.1992     (C)90/91/92 by Peter Hellinger Software *
  7.  *----------------------------------------------------------------------*
  8.  *            Dieses Modul ist urheberrechtlich geschtzt.              *
  9.  *                                                                      *
  10.  * Die Ver”ffentlichung des Quelltextes oder Teilen daraus, sowie die   *
  11.  * Verbreitung des bersetzten, nicht gelinkten Codes in schriftlicher, *
  12.  * oder maschinenlesbarer Form, insbesondere in Zeitschriften, Mail-    *
  13.  * boxen oder anderen Medien bedarf der ausdrcklichen schriftlichen    *
  14.  * Einverst„ndnisserkl„rung des Autors.                                 *
  15.  *                                                                      *
  16.  * Die Verbreitung des Moduls als Teil eines gelinkten Programms ist    *
  17.  * fr Lizenznehmer ausdrcklich erlaubt!  Der Autor beh„lt sich das    *
  18.  * Recht vor, diese Erlaubnis jederzeit und ohne Angaben von Grnden zu *
  19.  * widerrufen.                                                          *
  20.  *----------------------------------------------------------------------*)
  21.  
  22. IMPLEMENTATION MODULE mtAlerts;
  23.  
  24. (*----------------------------------------------------------------------*
  25.  * Int. Vers | Datum    | Name | Žnderung                               *
  26.  *-----------+----------+------+----------------------------------------*
  27.  *  3.00     | 18.01.92 |  Hp  |                                        *
  28.  *  3.01     | 09.02.92 |  Hp  | V”llig berarbeitet und neue Features  *
  29.  *           |          |      | eingebaut. Das Modul ist jetzt viel    *
  30.  *           |          |      | flexibler einzusetzen.                 *
  31.  *-----------+----------+------+----------------------------------------*)
  32.  
  33.  
  34.  
  35. (* IMPLEMENTATION FšR  >>> Megamax-Modula-2 <<< *)
  36. (*                                              *)
  37. (*$R-   Range-Checks                            *)
  38. (*$S-   Stack-Check                             *)
  39. (*                                              *)
  40. (*----------------------------------------------*)
  41.  
  42. FROM Storage IMPORT ALLOCATE, DEALLOCATE;
  43.  
  44.  
  45.  
  46.  
  47.  
  48. FROM MagicSys   IMPORT  Nil, Null, Bit0, Bit1, Bit2, Bit3, Bit4, Bit5, Bit6,
  49.                         Bit7, Bit8, Bit9, Bit10, Bit11, Bit12, Bit13, Bit14,
  50.                         Bit15, LOC, Byte, ByteSet, sWORD, sINTEGER, sCARDINAL,
  51.                         sBITSET, lINTEGER, lCARDINAL, lWORD, lBITSET,
  52.                         CastToChar, CastToByte, CastToByteset, CastToInt,
  53.                         CastToCard, CastToBitset, CastToWord, CastToLInt,
  54.                         CastToLCard, CastToLBitset, CastToLWord, CastToAddr,
  55.                         TosVersion, Accessory, Basepage, SysHeader, TosDate;
  56.  
  57.  
  58.  
  59.  
  60.  
  61.  
  62.  FROM SYSTEM             IMPORT  ADDRESS, ADR, CADR, TSIZE;  
  63.  
  64.  
  65.  
  66. FROM MagicAES           IMPORT  GBOX, GIMAGE, GIBOX, GBUTTON, GSTRING,
  67.                                 SELECTABLE, DEFAULT, Exit, LASTOB, OUTLINED,
  68.                                 DRAW3D, SHADOWED, OBJECT, GrafMkstate, 
  69.                                 PtrBITBLK, GICON, FL3DBAK;
  70. FROM mtDials            IMPORT  NewDial, ObjcExtype, GetObjcExtype,
  71.                                 GetKbdState, CSCREEN, CMOUSE, CPOS, DialCenter,
  72.                                 DSTART, DSHRINK, DFINISH, DDISABLE, DENABLE,
  73.                                 DialForm, DialDraw, DialDo, DisposeDial, 
  74.                                 UndoButton, IsOverloadedDialDo;
  75. FROM mtUtils            IMPORT  tRect, CalcArea, DoubleClick;
  76. FROM mtAppl             IMPORT  CharWidth, CharHeight, BoxWidth, BoxHeight,
  77.                                 MouseArrow, StoreMouse, RestoreMouse;
  78. FROM MagicStrings       IMPORT  Assign, Length;
  79. FROM MagicConvert       IMPORT  StrToInt;
  80. FROM MagicCookie        IMPORT  FindCookie;
  81. IMPORT  MagicAES, mtRsc;
  82.  
  83. (*----------------------------------------------------------------------*
  84.  *        Resource-Coder 1.03  (C)92 by Peter Hellinger Software        *
  85.  *----------------------------------------------------------------------*
  86.  *           Inline-Resource erzeugt am 09.02.1992 00:19:48             *
  87.  *----------------------------------------------------------------------*)
  88.  
  89. TYPE tRscData = ARRAY [0..532] OF CARDINAL;
  90.  
  91. CONST RscData = tRscData {
  92.         00001H, 00378H, 00378H, 00378H, 00324H, 00324H, 00024H, 00024H, 00378H, 
  93.         00420H, 00007H, 00001H, 00000H, 00000H, 00006H, 00000H, 00000H, 00424H, 
  94.         00003H, 0C000H, 00006H, 06000H, 0000DH, 0B000H, 0001BH, 0D800H, 00037H, 
  95.         0EC00H, 0006FH, 0F600H, 000DCH, 03B00H, 001BCH, 03D80H, 0037CH, 03EC0H, 
  96.         006FCH, 03F60H, 00DFCH, 03FB0H, 01BFCH, 03FD8H, 037FCH, 03FECH, 06FFCH, 
  97.         03FF6H, 0DFFCH, 03FFBH, 0BFFCH, 03FFDH, 0BFFCH, 03FFDH, 0DFFCH, 03FFBH, 
  98.         06FFCH, 03FF6H, 037FCH, 03FECH, 01BFFH, 0FFD8H, 00DFFH, 0FFB0H, 006FCH, 
  99.         03F60H, 0037CH, 03EC0H, 001BCH, 03D80H, 000DCH, 03B00H, 0006FH, 0F600H, 
  100.         00037H, 0EC00H, 0001BH, 0D800H, 0000DH, 0B000H, 00006H, 06000H, 00003H, 
  101.         0C000H, 03FFFH, 0FFFCH, 0C000H, 00003H, 09FFFH, 0FFF9H, 0BFFFH, 0FFFDH, 
  102.         0DFF8H, 03FFBH, 05FE0H, 00FFAH, 06FC0H, 007F6H, 02F83H, 083F4H, 03787H, 
  103.         0C3ECH, 01787H, 0C3E8H, 01BFFH, 083D8H, 00BFFH, 007D0H, 00DFEH, 00FB0H, 
  104.         005FCH, 01FA0H, 006FCH, 03F60H, 002FCH, 03F40H, 0037CH, 03EC0H, 0017CH, 
  105.         03E80H, 001BFH, 0FD80H, 000BFH, 0FD00H, 000DCH, 03B00H, 0005CH, 03A00H, 
  106.         0006CH, 03600H, 0002FH, 0F400H, 00037H, 0EC00H, 00017H, 0E800H, 0001BH, 
  107.         0D800H, 0000BH, 0D000H, 0000DH, 0B000H, 00005H, 0A000H, 00006H, 06000H, 
  108.         00003H, 0C000H, 0007FH, 0FE00H, 000C0H, 00300H, 001BFH, 0FD80H, 0037FH, 
  109.         0FEC0H, 006FFH, 0FF60H, 00DFFH, 0FFB0H, 01BFFH, 0FFD8H, 037FFH, 0FFECH, 
  110.         06FFFH, 0FFF6H, 0DFFFH, 0FFFBH, 0B181H, 0860DH, 0A081H, 00205H, 0A4E7H, 
  111.         03265H, 0A7E7H, 03265H, 0A3E7H, 03265H, 0B1E7H, 03205H, 0B8E7H, 0320DH, 
  112.         0BCE7H, 0327DH, 0A4E7H, 0327DH, 0A0E7H, 0027DH, 0B1E7H, 0867DH, 0BFFFH, 
  113.         0FFFDH, 0DFFFH, 0FFFBH, 06FFFH, 0FFF6H, 037FFH, 0FFECH, 01BFFH, 0FFD8H, 
  114.         00DFFH, 0FFB0H, 006FFH, 0FF60H, 0037FH, 0FEC0H, 001BFH, 0FD80H, 000C0H, 
  115.         00300H, 0007FH, 0FE00H, 03FFFH, 0FFFCH, 07FFFH, 0FFFEH, 07FF8H, 01FFEH, 
  116.         07FF0H, 00FFEH, 07FF0H, 00FFEH, 07FF0H, 00FFEH, 07FF0H, 00FFEH, 07FF0H, 
  117.         00FFEH, 07FF0H, 00FFEH, 07FF0H, 00FFEH, 07FF0H, 00FFEH, 07FF0H, 00FFEH, 
  118.         07FF0H, 00FFEH, 07FF0H, 00FFEH, 07FF0H, 00FFEH, 07FF0H, 00FFEH, 07FF0H, 
  119.         00FFEH, 07FF0H, 00FFEH, 07FF8H, 01FFEH, 07FFCH, 03FFEH, 07FFFH, 0FFFEH, 
  120.         07FFFH, 0FFFEH, 07FFFH, 0FFFEH, 07FFCH, 03FFEH, 07FF8H, 01FFEH, 07FF0H, 
  121.         00FFEH, 07FF0H, 00FFEH, 07FF8H, 01FFEH, 07FFCH, 03FFEH, 07FFFH, 0FFFEH, 
  122.         03FFFH, 0FFFCH, 00000H, 00000H, 03FFFH, 0FFFCH, 07FFFH, 0FFFEH, 07FF8H, 
  123.         01FFEH, 07FE0H, 007FEH, 07F80H, 001FEH, 07F00H, 000FEH, 07E00H, 0007EH, 
  124.         07E01H, 0C07EH, 07E03H, 0C07EH, 07F07H, 080FEH, 07FFFH, 001FEH, 07FFEH, 
  125.         001FEH, 07FFCH, 003FEH, 07FF8H, 007FEH, 07FF8H, 007FEH, 07FF0H, 00FFEH, 
  126.         07FF0H, 00FFEH, 07FF0H, 00FFEH, 07FF8H, 01FFEH, 07FFCH, 03FFEH, 07FFFH, 
  127.         0FFFEH, 07FFFH, 0FFFEH, 07FFCH, 03FFEH, 07FF8H, 01FFEH, 07FF0H, 00FFEH, 
  128.         07FF0H, 00FFEH, 07FF0H, 00FFEH, 07FF8H, 01FFEH, 07FFCH, 03FFEH, 07FFFH, 
  129.         0FFFEH, 03FFFH, 0FFFCH, 00000H, 00000H, 03FFFH, 0FFFCH, 07FFFH, 0FFFEH, 
  130.         07FFFH, 0FFFEH, 07FFEH, 0FFFEH, 07FFCH, 07FFEH, 07FECH, 067FEH, 07FC4H, 
  131.         047FEH, 07FC4H, 047FEH, 07F44H, 047FEH, 07E44H, 047FEH, 07E44H, 047FEH, 
  132.         07E44H, 047FEH, 07E44H, 047FEH, 07E44H, 047FEH, 07E40H, 0071EH, 07E00H, 
  133.         0061EH, 07E00H, 0061EH, 07E00H, 0043EH, 07E00H, 0003EH, 07E00H, 0007EH, 
  134.         07E00H, 0007EH, 07E00H, 000FEH, 07E00H, 000FEH, 07E00H, 001FEH, 07E00H, 
  135.         001FEH, 07E04H, 003FEH, 07F02H, 007FEH, 07FFFH, 0FFFEH, 07FFFH, 0FFFEH, 
  136.         07FFFH, 0FFFEH, 03FFFH, 0FFFCH, 00000H, 00000H, 00000H, 00024H, 00004H, 
  137.         00020H, 00000H, 00000H, 00001H, 00000H, 000A4H, 00004H, 00020H, 00000H, 
  138.         00000H, 00001H, 00000H, 00124H, 00004H, 00020H, 00000H, 00000H, 00001H, 
  139.         00000H, 001A4H, 00004H, 00020H, 00000H, 00000H, 00001H, 00000H, 00224H, 
  140.         00004H, 00020H, 00000H, 00000H, 00001H, 00000H, 002A4H, 00004H, 00020H, 
  141.         00000H, 00000H, 00001H, 0FFFFH, 00001H, 00006H, 00014H, 00000H, 00000H, 
  142.         000FFH, 01240H, 00001H, 00001H, 00023H, 00804H, 00002H, 0FFFFH, 0FFFFH, 
  143.         00017H, 00000H, 00000H, 00000H, 00324H, 00001H, 00001H, 02000H, 02000H, 
  144.         00003H, 0FFFFH, 0FFFFH, 00017H, 00000H, 00000H, 00000H, 00332H, 00006H, 
  145.         00001H, 02000H, 02000H, 00004H, 0FFFFH, 0FFFFH, 00017H, 00000H, 00000H, 
  146.         00000H, 00340H, 0000BH, 00001H, 02000H, 02000H, 00005H, 0FFFFH, 0FFFFH, 
  147.         00017H, 00000H, 00000H, 00000H, 0034EH, 00011H, 00001H, 02000H, 02000H, 
  148.         00006H, 0FFFFH, 0FFFFH, 00017H, 00000H, 00000H, 00000H, 0035CH, 00017H, 
  149.         00001H, 02000H, 02000H, 00000H, 0FFFFH, 0FFFFH, 00017H, 00020H, 00000H, 
  150.         00000H, 0036AH, 0001DH, 00001H, 02000H, 02000H, 00000H, 00378H, 00000H,
  151.         00000H, 00000H
  152.         }; (* Ende RscData *) 
  153.  
  154.  
  155.  
  156. (*----------------------------------------------------------------------*)
  157.  
  158. CONST   cMaxChars =      60;    (* Maximale Zeichenzahl pro Zeile *)
  159.         cMaxText =       16;    (* Maximale Anzahl Zeilen *)
  160.         cMaxButt =        5;    (* Maximale Anzahl Buttons *)
  161.         cMaxIcon =      256;    (* Maximale Anzahl Iconslots *)
  162.         
  163. CONST   Box =           0;
  164.         Mover =         1;
  165.  
  166. CONST   Left =          0;
  167.         Center =        1;
  168.         Right =         2;
  169.  
  170. TYPE    tString =       ARRAY [0..cMaxChars] OF CHAR;
  171.         Objctree =      POINTER TO ARRAY [0..MAX(sINTEGER)] OF OBJECT;
  172.  
  173. VAR     Slot:           ARRAY [1..cMaxIcon] OF PtrBITBLK;
  174.         Tree:           ARRAY [0..23] OF OBJECT;
  175.         Text:           ARRAY [1..cMaxText] OF tString;
  176.         Button:         ARRAY [1..cMaxButt] OF RECORD
  177.                                                 text: tString;
  178.                                                 objc: sINTEGER;
  179.                                                END;
  180.         buttmode:       sINTEGER;
  181.         IconColor:      sINTEGER;
  182.         TheAlert:       Objctree;
  183.         Icontree:       Objctree;
  184.         rsc:            mtRsc.RESOURCE;
  185.         rscData:        POINTER TO tRscData;
  186.         inAlert:        BOOLEAN;
  187.  
  188.  
  189. PROCEDURE SetObjc (objc, typ, x, y, w, h: sINTEGER; f, s: sBITSET; 
  190.                    spec: ADDRESS);
  191. BEGIN
  192.  Tree[objc].obNext:= -1;
  193.  Tree[objc].obHead:= -1;
  194.  Tree[objc].obTail:= -1;
  195.  Tree[objc].obType:= typ;
  196.  Tree[objc].obFlags:= f;
  197.  Tree[objc].obState:= s;
  198.  Tree[objc].obSpec.address:= spec;
  199.  Tree[objc].obX:= x;
  200.  Tree[objc].obY:= y;
  201.  Tree[objc].obWidth:= w;
  202.  Tree[objc].obHeight:= h;
  203.  MagicAES.ObjcAdd (TheAlert, Box, objc);
  204. END SetObjc;
  205.  
  206. PROCEDURE PrepareAlert;
  207. BEGIN
  208.  Tree[Box].obNext:= -1;
  209.  Tree[Box].obHead:= -1;
  210.  Tree[Box].obTail:= -1;
  211.  Tree[Box].obType:= GBOX;
  212.  Tree[Box].obFlags:= {FL3DBAK};
  213.  Tree[Box].obState:= {OUTLINED};
  214.  Tree[Box].obSpec.Box.char:= 0C;
  215.  Tree[Box].obSpec.Box.frame:= 2C;
  216.  (* Tree[Box].obSpec.Box.flags:= {Bit0,Bit11, Bit12}; *)
  217.  Tree[Box].obSpec.Box.flags:= {Bit11, Bit12};
  218. (*- Nur einmal setzen, sonst klappt in mtDials 'an letzer Pos' nicht...
  219.  Tree[Box].obX:= 0;  Tree[Box].obY:= 0;
  220.  *)
  221.  Tree[Box].obWidth:= 0;
  222.  Tree[Box].obHeight:= 0;
  223.  SetObjc (Mover, 1119H, 0, 0, 16, 16, {}, {OUTLINED}, Null);
  224.  Tree[Mover].obSpec.Box.char:= 0C;
  225.  Tree[Mover].obSpec.Box.frame:= 1C;
  226.  Tree[Mover].obSpec.Box.flags:= {Bit11, Bit12};
  227. END PrepareAlert;
  228.  
  229. PROCEDURE Iconslot (slot: sINTEGER): MagicAES.PtrBITBLK;
  230. BEGIN
  231.  IF (slot > 0) AND (slot < 257) THEN  RETURN Slot[slot];  END;
  232.  RETURN NIL;
  233. END Iconslot;
  234.  
  235. PROCEDURE SetIconslot (slot: sINTEGER; icon: MagicAES.PtrBITBLK);
  236. BEGIN
  237.  (* Achtung, Standard-Icons nicht berschreiben! *)
  238.  IF slot < 254 THEN  Slot[slot + 3]:= icon;  END;
  239. END SetIconslot;
  240.  
  241. PROCEDURE IconNum (VAR num : ARRAY OF CHAR): sINTEGER;
  242. (* Added by Dirk Steins *)
  243. BEGIN
  244.  IF (num[0] >="A") THEN RETURN ORD (num[0]) - 55;
  245.                    ELSE RETURN StrToInt (num)
  246.  END;
  247. END IconNum;
  248.  
  249. PROCEDURE idoAlert (xp, yp, mode, def: sINTEGER; REF str: ARRAY OF CHAR): sINTEGER;
  250. VAR (*$Reg*)  i: sINTEGER;
  251.     (*$Reg*)  j: sINTEGER;
  252.     (*$Reg*)  h: sINTEGER;
  253.     (*$Reg*)  cw2: sINTEGER;
  254.     c, text, butt, ioff, tw, bw, w2, hi, objc, y, ypos, typ: sINTEGER;
  255.     num: ARRAY [0..10] OF CHAR;
  256.     icon, bool: BOOLEAN;
  257.     conf, b, set: sBITSET;
  258.     clip, s, x: tRect;
  259.     iblk: PtrBITBLK;
  260.     DefaultButton : BOOLEAN;
  261.     idx : INTEGER;
  262.  
  263. BEGIN
  264.  (* Initialisieren *)
  265.  PrepareAlert;
  266.  FOR i:= 1 TO cMaxText DO  Text[i, 0]:= 0C;  END;
  267.  FOR i:= 1 TO cMaxButt DO  Button[i].text[0]:= 0C;  Button[i].objc:= -1;  END;
  268.  FOR i:= 0 TO 10 DO num[i]:= 0C;  END;
  269.  i:= 0;  h:= Length (str);  objc:= 2;  cw2:= CharWidth * 2;
  270.  ioff:= cw2;  ypos:= CharHeight;
  271.  IF (i >= h) OR (str[0] # '[') THEN  RETURN -1;  END;
  272.  
  273.  (* Image-Nummer auslesen *)
  274.  i:= 1;  j:= 0;
  275.  WHILE str[i] # ']' DO num[j]:= str[i];  INC(i);  INC(j);  END;
  276.  num[j]:= 0C;
  277.  
  278.  (* Image aus der Image-Liste holen *)
  279.  iblk:= Iconslot (IconNum (num));
  280.  IF iblk # NIL THEN
  281.   INC (ioff, (iblk^.biWb * 8));  INC (ypos, iblk^.biHl + (CharHeight * 2));
  282.   iblk^.biColor:= IconColor;
  283.   SetObjc (2, GIMAGE, CharWidth, CharHeight, 
  284.            iblk^.biWb * 8, iblk^.biHl, {}, {}, iblk);
  285.   objc:= 3;
  286.  ELSE
  287.   INC (ypos, CharHeight * 2);
  288.  END;
  289.  
  290.  (* Alles bis zum n„chsten '[' berspringen *)
  291.  WHILE (str[i] # '[')  DO  IF i > h THEN  RETURN -1;  END;  INC (i);  END;
  292.  
  293.  (* Textzeilen auslesen. Die einzelnen Zeichen sind durch '|' getrennt *)
  294.  text:= 1;  tw:= 0;
  295.  LOOP
  296.   typ:= 0;  set:= {};
  297.   j:= 0;  INC (i);  IF i > h THEN  RETURN -1;  END;
  298.   WHILE (str[i] # '|') AND (str[i] # ']') AND (i <= h) AND (j < cMaxChars) DO
  299.    IF str[i] = '%' THEN
  300.     CASE str[i + 1] OF
  301.      'D':  INCL (set, OUTLINED);  typ:= 01300H;  INC (i, 2);|
  302.      'U':  INCL (set, SHADOWED);  typ:= 01300H;  INC (i, 2);|
  303.      'F':  INCL (set, DRAW3D);    typ:= 01300H;  INC (i, 2);|
  304.      ELSE  Text[text, j]:= str[i];  
  305.            Text[text, j + 1]:= str[i + 1];
  306.            INC (i, 2);  INC (j, 2);
  307.     END;
  308.    ELSE
  309.     Text[text, j]:= str[i];  INC (i);  INC (j);
  310.    END; 
  311.   END;
  312.   Text [text, j]:= 0C;  c:= j * CharWidth;
  313.   SetObjc (objc, GSTRING + typ, ioff, (text * CharHeight), 
  314.            c, CharHeight, {}, set, ADR (Text[text]));
  315.  
  316.   IF tw < (c+ioff) THEN tw:= c + ioff;  END;
  317.   INC (objc);  INC (text);
  318.   IF (text > cMaxText+1) THEN  RETURN - 1;  END;
  319.   IF (str[i] = ']') THEN  EXIT;  END;
  320.  END;
  321.  
  322.  (* Y-Position der Buttons *)
  323.  IF ((text+1) * CharHeight) > ypos THEN  c:= (text + 1) * CharHeight;
  324.                                 ELSE  c:= ypos;
  325.  END;
  326.  
  327.  (* Bis zum Beginn der Buttontexte scannen *)
  328.  WHILE (str[i] # '[')  DO  IF i > h THEN  RETURN -1;  END;  INC (i);  END;
  329.  
  330.  (* Buttons auslesen. Die Buttons sind durch | getrennt. Ein '[' kennzeichnet
  331.   * die Ausl”setaste des Buttons.
  332.   *)
  333.  butt:= 1;  bw:= 0;
  334.  
  335.  DefaultButton := FALSE;  (* Bisher kein Default-Button gefunden *)
  336.  
  337.  LOOP
  338.   Button[butt].text[0]:= ' ';  j:= 1;  INC (i);
  339.   IF i > h THEN  RETURN -1;  END;
  340.   (* Undo-Button kann mit ':', Defaultbutton mit '.' erzwungen werden *)
  341.   set:= {Exit, SELECTABLE};
  342.   IF str[i] = ':'
  343.   THEN
  344.     INCL(set, UndoButton);    (* Undo eintragen                *)
  345.     INC(i);                   (* Marker berspringen           *)
  346.   ELSIF (str[i] = '.') AND ~DefaultButton
  347.   THEN
  348.     INCL(set, DEFAULT);       (* DEFAULT eintragen             *)
  349.     DefaultButton := TRUE;    (* merken, daž bersteuert wurde *)
  350.     INC(i);                   (* Marker berspringen           *)
  351.   END;
  352.  
  353.   WHILE (str[i] # '|') AND (str[i] # ']') AND (i <= h) AND (j < cMaxChars) DO
  354.    Button[butt].text[j]:= str[i];  INC (i);  INC (j);
  355.   END;
  356.   Button[butt].text[j]:= ' ';  INC (j);  Button[butt].text[j]:= 0C;
  357. (* fr Button-šbersteuerung entfernt
  358.   IF butt = def THEN  set:= {DEFAULT, SELECTABLE, Exit};
  359.                 ELSE  set:= {Exit, SELECTABLE};
  360.   END;
  361. *)
  362.   
  363.   (* Merken, welche Objektnummer wir gekriegt haben *)
  364.   Button[butt].objc:= objc;
  365.  
  366.   (* Button in den Baum eintragen *)
  367.   SetObjc (objc, 0121AH, 0, c, CharWidth * j, CharHeight, set, {},
  368.            ADR (Button[butt].text));
  369.  
  370.   (* Buttons auf gleiche Gr”že bringen *)
  371.   IF butt > 1 THEN
  372.    IF Tree[objc].obWidth < Tree[objc - 1].obWidth THEN
  373.     Tree[objc].obWidth:= Tree[objc - 1].obWidth;
  374.    ELSIF Tree[objc].obWidth > Tree[objc - 1].obWidth THEN
  375.     FOR idx := 1 TO butt DO
  376.       Tree[Button[idx].objc].obWidth:= Tree[objc].obWidth;
  377.     END;
  378.    END;
  379.   END;
  380.  
  381.   INC (objc);  INC (butt);
  382.   IF str[i] = ']' THEN  EXIT;  END;
  383.   IF (butt > cMaxButt+1) THEN  RETURN -1;  END;
  384.  END; (* LOOP *)
  385.  
  386.  DEC (butt);
  387.  
  388.  bw:= 0;
  389.  FOR i:= 1 TO butt DO
  390.   INC (bw, Tree[Button[i].objc].obWidth);
  391.   IF i > 1 THEN  INC (bw, cw2);  END;
  392.   (* Wenn kein erzwungener Defaultbutton da war, jetzt den bergebenen setzen *)
  393.   IF ~DefaultButton AND (i = def)
  394.     THEN
  395.       INCL (Tree[Button[i].objc].obFlags, DEFAULT);
  396.     END;
  397.  END;
  398.  
  399.  (* Grundobjekt korrigieren *)
  400.  IF tw > bw THEN  w2:= tw + CharWidth;  ELSE  w2:= bw;  END;
  401.  INC (w2, cw2);  (* Abstand linker Rand *)
  402.  INC (w2, cw2);  (* Abstand rechten Rand *)
  403.  Tree[Box].obWidth:= w2;
  404.  Tree[Box].obHeight:= Tree[Button[butt].objc].obY + (2 * CharHeight);
  405.  Tree[Mover].obX:= Tree[Box].obWidth - Tree[Mover].obWidth;
  406.  
  407.  (* Buttons zentrieren *)
  408.  CASE buttmode OF
  409.   Left:    w2:= cw2;|
  410.   Center:  w2:= (Tree[Box].obWidth - bw) DIV 2;|
  411.   ELSE     w2:= (Tree[Box].obWidth - bw) - cw2;
  412.  END;
  413.  
  414.  FOR i:= 1 TO butt DO
  415.   Tree[Button[i].objc].obX:= w2;
  416.   INC (w2, Tree[Button[i].objc].obWidth);  INC (w2, cw2);
  417.  END;
  418.  
  419.  IF NOT NewDial (TheAlert) THEN  
  420.    butt := MagicAES.FormAlert (1, "[3][mtAlerts:|Nicht genug Speicher|fr Alert!][Abbruch]");
  421.    RETURN -1;
  422.  END;
  423.  IF mode = 2 THEN  DialCenter (TheAlert, CPOS, xp, xp, clip);
  424.              ELSE  DialCenter (TheAlert, CSCREEN, 0, 0, clip);
  425.  END;
  426.  IF IsOverloadedDialDo()
  427.  THEN
  428.    (* MagicAES.WindUpdate (MagicAES.BEGUPDATE); *)
  429.    StoreMouse;  MouseArrow;
  430.    c:= DialDo (TheAlert, -1);
  431.    RestoreMouse;
  432.    bool:= DoubleClick (c);
  433.    (* MagicAES.WindUpdate (MagicAES.ENDUPDATE); *)
  434.  ELSE
  435.    MagicAES.WindUpdate (MagicAES.BEGUPDATE);
  436.    DialForm (TheAlert, DSTART, s, x);
  437.    DialDraw (TheAlert, 0, 1, clip, FALSE);
  438.    StoreMouse;  MouseArrow;
  439.    c:= DialDo (TheAlert, -1);
  440.    RestoreMouse;
  441.    bool:= DoubleClick (c);
  442.    DialForm (TheAlert, DFINISH, s, x);
  443.    DisposeDial (TheAlert);
  444.    MagicAES.WindUpdate (MagicAES.ENDUPDATE);
  445.  END;
  446.  
  447.  FOR j:= 1 TO butt DO
  448.   IF c = Button[j].objc THEN  RETURN j;  END;
  449.  END;
  450.  RETURN -1;
  451. END idoAlert;
  452.  
  453. PROCEDURE doAlert (xp, yp, mode, def: sINTEGER; REF str: ARRAY OF CHAR): sINTEGER;
  454.  VAR res: sINTEGER;
  455. BEGIN
  456.   IF inAlert THEN RETURN -1 END;
  457.   inAlert := TRUE;
  458.   res := idoAlert (xp, yp, mode, def, str);
  459.   inAlert := FALSE;
  460.   RETURN res;
  461. END doAlert;
  462.  
  463. PROCEDURE Alert (def: sINTEGER; REF str: ARRAY OF CHAR): sINTEGER;
  464. BEGIN
  465.  RETURN doAlert (0, 0, 0, def, str);
  466. END Alert;
  467.  
  468. PROCEDURE PosAlert (x, y, def: sINTEGER; REF str: ARRAY OF CHAR): sINTEGER;
  469. BEGIN
  470.  RETURN doAlert (x, y, 2, def, str);
  471. END PosAlert;
  472.  
  473. PROCEDURE SetIconColor (color: sINTEGER);
  474. BEGIN
  475.  IconColor:= color;
  476. END SetIconColor;
  477.  
  478. PROCEDURE ConfigAlert (mode: AlertMode);
  479. VAR i: sINTEGER;
  480. BEGIN
  481.  CASE mode OF
  482.   left:    buttmode:= Left;|
  483.   center:  buttmode:= Center;|
  484.   right:   buttmode:= Right;|
  485.   gemicon: FOR i:= 1 TO 3 DO  Slot[i]:= Icontree^[i].obSpec.ImagePtr;  END;|
  486.   alticon: FOR i:= 1 TO 3 DO  Slot[i]:= Icontree^[i+3].obSpec.ImagePtr;  END;|
  487.   ELSE     ;
  488.  END;
  489. END ConfigAlert;
  490.  
  491. VAR init: sCARDINAL;
  492.  
  493. PROCEDURE InitMtAlerts;
  494. CONST MacBut    = 8;
  495.       alRight   = 9;
  496.       alCenter  = 10;
  497.       alLeft    = 11;
  498. CONST Magic = 'MagC';
  499.  
  500. VAR i: sINTEGER;
  501.     a: RECORD 
  502.         CASE : INTEGER OF
  503.         0 : lc : lCARDINAL; |
  504.         1 : x  : RECORD
  505.                  v : INTEGER;
  506.                  s : sBITSET;
  507.                  END;
  508.         END;
  509.        END;
  510. BEGIN
  511.  IF init # 30961 THEN
  512.   (* Hmm, eine uninitialisierte Variable ist natrlich eine schwammige
  513.    * Methode, aber wie soll man sonst feststellen, ob der Modulk”rper
  514.    * bereits durchlaufen wurde? Alles 'legale' mžte im Modulk”rper
  515.    * ausgefhrt werden! Der Gott der Informatiker m”ge mir verzeihen...
  516.    *)
  517.   (* Initialisierung der Alertroutinen *)
  518.   inAlert := FALSE;
  519.   IconColor:= 1;  TheAlert:= ADR (Tree);
  520.   Tree[Box].obX:= 0;  Tree[Box].obY:= 0;
  521.   FOR i:= 1 TO cMaxIcon DO  Slot[i]:= NIL;  END;
  522.   FOR i:= 0 TO 23 DO Tree[i].obType := GBOX; END;
  523.  
  524.   (* Erstmal Speicher fr Ressource dafr allozieren *)
  525.   ALLOCATE (rscData, TSIZE (tRscData));
  526.   IF rscData = NIL THEN HALT END;   (* Kein Speicher fr interne Ressource *)
  527.   (* Jetzt Resourcedaten kopieren *)
  528.   rscData^ := RscData;
  529.   (* Und jetzt relozieren *)
  530.   IF mtRsc.RelocRsc (rscData, rsc) THEN 
  531.    Icontree:= mtRsc.GaddrRsc (rsc, MagicAES.RTREE, 0);
  532.   ELSE
  533.    HALT; (* Resource laden fehlgeschlagen!  B”ser Fehler!!! *)
  534.   END;
  535.   (* Jetzt nach Cookie suchen und ggf. Einstellungen daraus bernehmen *)
  536.   IF FindCookie (Magic, a.lc) THEN
  537.     (* Cookie gefunden *)
  538.     WITH a.x DO
  539.       IF v = 00H        (* Versionsnummer im ersten Wort *)
  540.       THEN
  541.         IF MacBut IN s
  542.         THEN
  543.           ConfigAlert (alticon)
  544.         ELSE
  545.           ConfigAlert (gemicon)
  546.         END;
  547.         IF alLeft IN s
  548.         THEN
  549.           ConfigAlert (left);
  550.         ELSIF alRight IN s
  551.         THEN
  552.           ConfigAlert (right);
  553.         ELSE
  554.           ConfigAlert (center);
  555.         END;
  556.       END;
  557.     END (* WITH *)
  558.   ELSE
  559.     ConfigAlert (center);  ConfigAlert (gemicon);
  560.   END;
  561.   init:= 30961;
  562.  END;
  563. END InitMtAlerts;
  564.  
  565. BEGIN
  566.  init:= 0;
  567.  inAlert := FALSE;
  568.  InitMtAlerts;
  569. END mtAlerts.
  570.  
  571.